with Cairo.Support;
with SDL.Video;
with System;
with Ada.Unchecked_Conversion;
package body Cairo.CairoSDL is

   reciprocal_table : Reciprocal_Table_Type;
   CAIROSDL_TARGET_KEY : aliased Cairo_User_Data_Key;

   procedure Mark_Dirty (Surface : Cairo.Surface_Ptr)
   is
   begin
      null;
--      Mark_Dirty_Rect(Surface, 0, 0, 32767, 32767);
   end Mark_Dirty;

   procedure sdl_surface_destroy_func (data : Cairo_User_Data) 
      with Convention => C;

   procedure sdl_surface_destroy_func (data : Cairo_User_Data)
   is
      use SDL.Video;
      pragma Warnings(Off);
      function To_Surface_Ptr is 
         new Ada.Unchecked_Conversion(Cairo_User_Data, Surface_Access_t);
      surface : Surface_Access_t := To_Surface_Ptr(data);
   begin
      if surface /= null then
         SDL.Video.Free_Surface(surface);
      end if;
   end sdl_surface_destroy_func;

   function Create_Cairo_Surface (
      Source : SDL.Video.Surface_Access_t
      ) return Cairo.Surface_Ptr
   is
      use Support;
      format : Cairo.Cairo_Format;
      target : Cairo.Surface_Ptr;
      dummy  : Cairo_Status;
      is_dirty : Boolean;

      pragma Warnings(Off);
      function To_Cairo_User_Data_Key is
         new Ada.Unchecked_Conversion(System.Address, Cairo_User_Data_Key);

      function To_Cairo_User_Data is
         new Ada.Unchecked_Conversion(SDL.Video.Surface_Access_t, Cairo_User_Data);

   begin
      -- Cairo only supports a limited number of pixels formats.  Make sure the surface format is compatible. 
      if Source.Format.BytesPerPixel /= 4 or else Source.Format.BitsPerPixel /= 32 then
         raise Constraint_Error with "unsupported_format";
      end if;
      if Source.Format.Rmask /= CAIROSDL_RMASK or else
         Source.Format.Gmask /= CAIROSDL_GMASK or else
         Source.Format.Bmask /= CAIROSDL_BMASK then
         raise Constraint_Error with "unsupported_format";
      end if;
      case Source.Format.Amask is
         when CAIROSDL_AMASK => format := CAIRO_FORMAT_ARGB32;
         when 0 => format := CAIRO_FORMAT_RGB24;
         when others => raise Constraint_Error with "unsupported_format";
      end case;
      -- Make the target point to either the SDL_Surface's data itself
      -- or a shadow image surface if we need to unpremultiply pixels. 
    if format = CAIRO_FORMAT_RGB24 then
       -- The caller is expected to have locked the surface (_if_ it
       -- needs locking) so that sdl_surface->pixels is valid and
       -- constant for the lifetime of the cairo_surface_t.  However,
       -- we're told not to call any OS functions when a surface is
       -- locked, so we really shouldn't call
       -- cairo_image_surface_create () as it will malloc, so really
       -- if the surface needs locking this shouldn't be used.
       --
       -- However, it turns out malloc is actually safe on many (all?)
       -- platforms so we'll just go ahead anyway. 
        target := cairo_image_surface_create_for_data (
           System.Address(Source.Pixels),
           format,
           Source.w,
           Source.h,
           int(Source.pitch));
        is_dirty := False;
    else
       -- Need a shadow image surface. 
       target := cairo_image_surface_create (CAIRO_FORMAT_ARGB32, Source.w, Source.h);
       is_dirty := True;
    end if;

    if cairo_surface_status (target) = CAIRO_STATUS_SUCCESS then 
       Source.refcount := Source.refcount + 1;
       dummy := cairo_surface_set_user_data (
          target,
          To_Cairo_User_Data_Key(CAIROSDL_TARGET_KEY'Address),
          To_Cairo_User_Data(Source),
          sdl_surface_destroy_func'Access);
       if is_dirty then
          Mark_Dirty(target);
       end if;
    end if;
    return target;
   end Create_Cairo_Surface;

   function Cell_Div (A, B : Uint32_t) return Uint32_t 
   is
      pragma Inline(Cell_Div);
   begin
      return (A + B - 1) / B;
   end Cell_Div;

   function Shift (X : Uint32_t; Y : Integer) return Uint32_t 
   is 
      pragma Inline(Shift);
   begin
      return (if Y < 0 then X / (2 ** (-Y)) else X * (2 ** Y));
   end Shift;

   function To_Pixel (R, G, B, A : Uint32_t) return Uint32_t 
   is 
      pragma Inline(To_Pixel);
   begin
      return (R and RMASK) or (G and GMASK) or (B and BMASK) or (A and AMASK);
   end To_Pixel;

   procedure Extract_SDL_Pixel (RGBA : Uint32_t; R, G, B, A : out Uint32_t)
   is
      pragma Inline(Extract_SDL_Pixel);
   begin
      A := (RGBA / (2 ** ASHIFT)) and 16#FF#;
      R := (RGBA / (2 ** RSHIFT)) and 16#FF#;
      G := (RGBA / (2 ** GSHIFT)) and 16#FF#;
      B := (RGBA / (2 ** BSHIFT)) and 16#FF#;
      R := Shift(R * A * 257 + 32768, RSHIFT - 16);
      G := Shift(G * A * 257 + 32768, GSHIFT - 16);
      B := Shift(B * A * 257 + 32768, BSHIFT - 16);
   end Extract_SDL_Pixel;

   procedure Extract_Cairo_Pixel (RGBA : Uint32_t; R, G, B, A : out Uint32_t)
   is
      pragma Inline(Extract_Cairo_Pixel);
      recip : Uint32_t;
   begin
      A := (RGBA / (2 **  ASHIFT)) and 255;
      R := (RGBA / (2 **  RSHIFT)) and 255;
      G := (RGBA / (2 **  GSHIFT)) and 255;
      B := (RGBA / (2 **  BSHIFT)) and 255;
      recip := reciprocal_table(A);
      R := Shift(R * recip, RSHIFT - RECIPROCAL_BITS);
      G := Shift(G * recip, GSHIFT - RECIPROCAL_BITS);
      B := Shift(B * recip, BSHIFT - RECIPROCAL_BITS);
   end Extract_Cairo_Pixel;

   procedure Init (Table : in out Reciprocal_Table_Type)
   is
   begin
      Table(0) := 0;
      for i in 1 .. Table'Last loop
         Table(i) := Cell_Div(255 * (2 ** RECIPROCAL_BITS), i);
      end loop;
   end Init;

   procedure Unpremultiply_Row (
      Dst : in out Pixel_Line_Type;
      Src : Pixel_Line_Type;
      Num_Pixels : Natural
      )
   is
      i : Natural := 0;
   begin
      while i < Num_Pixels  loop
         -- We want to identify long runs of constant input pixels and cache the unpremultiplied.  
         declare
            const_in, const_out : Uint32_t;
            diff : Uint32_t := 0;
            --  Diff is the or of all bitwise differences from const_in
            -- during the probe period.  If it is zero after the probe
            -- period then every input pixel was identical in the probe. 
            accu : Uint32_t := not (2 * 255);
            -- Accumulator for all alphas of the probe period pixels, biased to make the sum zero if the 
         begin
            declare
               rgba, a, r, g, b : Uint32_t;
            begin
               const_in := Src(Src'First + i);
               rgba := const_in;
               Extract_Cairo_Pixel(rgba, r, g, b, a);
               accu := accu + a;
               const_out := To_Pixel(r, g, b, rgba);
               Dst(Dst'First + i) := const_out;
            end;
            exit when i + 1 = Num_Pixels;
            declare
               rgba, a, r, g, b : Uint32_t;
            begin
               rgba := Src(Src'First + i + 1);
               Extract_Cairo_Pixel(rgba, r, g, b, a);
               accu := accu + a;
               diff := rgba xor const_in;
               Dst(Dst'First + i + 1) := To_Pixel(r, g, b, rgba);
            end;
            i := i + 2;
            -- Fall into special cases if we have special circumstances. 
            if 0 /= (accu and diff) then 
               goto continue;
            end if;
            if 0 = accu then
               -- a run of solid pixels. 
               declare
                  n : Uint32_t;
               begin
                  loop
                     n := Src(Src'First + i);
                     exit when AMASK /= (n and AMASK);
                     Dst(Dst'First + i) := n;
                     i := i + 1;
                     if i = Num_Pixels then
                        return;
                     end if;
                  end loop;
               end;
            elsif 0 = diff then
               -- a run of constant pixels. 
               while Src(Src'First + i) = const_in loop
                  Dst(Dst'First + i) := const_out;
                  i := i + 1;
                  if i = Num_Pixels then
                     return;
                  end if;
               end loop;
            end if;
         end;
         <<continue>>
      end loop;
   end Unpremultiply_Row;

   procedure Premultiply_Row (
      Dst : in out Pixel_Line_Type;
      Src : Pixel_Line_Type;
      Num_Pixels : Natural
      )
   is
      i : Natural := 0;
   begin
      while i < Num_Pixels loop
         -- We want to identify long runs of constant input pixels and cache the unpremultiplied.  */
         declare
            const_in, const_out : Uint32_t;
            -- Diff is the or of all bitwise differences from const_in
            -- during the probe period.  If it is zero after the probe
            -- period then every input pixel was identical in the
            -- probe. 
            diff : Uint32_t := 0;
            -- Accumulator for all alphas of the probe period pixels, biased to make the sum zero if the 
            accu : Uint32_t := not (2 * 255);
         begin
            declare
               rgba, a, r, g, b : Uint32_t;
            begin
               const_in := Src(Src'First + i);
               rgba := const_in;
               Extract_SDL_Pixel(rgba, r, g, b, a);
               accu := accu + a;
               const_out := To_Pixel(r, g, b, rgba);
               Dst(Dst'First + i) := const_out;
            end;
            exit when i + 1 = Num_Pixels;
            declare
               rgba, a, r, g, b : Uint32_t;
            begin
               rgba := Src(Src'First + i + 1);
               Extract_SDL_Pixel(rgba, r, g, b, a);
               accu := accu + a;
               diff := rgba xor const_in;
               Dst(Dst'First + i + 1) := To_Pixel(r, g, b, rgba);
            end;
            i := i + 2;
            if 0 /= (accu and diff) then
               goto continue;
               if 0 = accu then
                  -- a run of solid pixels. 
                  declare
                     n : Uint32_t;
                  begin
                     loop
                        n := Src(Src'First + i);
                        exit when AMASK /= (n and AMASK);
                        Dst(Dst'First + i) := n;
                        i := i + 1;
                        if i = Num_Pixels then
                           return;
                        end if;
                     end loop;
                  end;
               elsif 0 = diff then
                  -- a run of constant pixels. 
                  while Src(Src'First + i) = const_in loop
                     Dst(Dst'First + i) := const_out;
                     i := i + 1;
                     if i = Num_Pixels then
                        return;
                     end if;
                  end loop;
               end if;
            end if;
         end;
            -- Fall into special cases if we have special  circumstances. 
         <<continue>>
      end loop;
   end Premultiply_Row;

   procedure Blit_And_Unpremultiply (
      Target_Buffer : in out Pixel_Line_Type;
      Target_Stride : Natural;
      Source_Buffer : Pixel_Line_Type;
      Source_Stride : Natural;
      Width, Height : Natural
      )
   is
      Target_Bytes : Natural := Target_Buffer'First;
      Source_Bytes : Natural := Source_Buffer'First;
   begin
      for i in 1 .. Height loop
         Unpremultiply_Row (
            Target_Buffer(Target_Bytes .. Target_Buffer'Last),
            Source_Buffer(Source_Bytes .. Source_Buffer'Last),
            Width);
         Target_Bytes := Target_Bytes + Target_Stride;
         Source_Bytes := Source_Bytes + Source_Stride;
      end loop;
   end Blit_And_Unpremultiply;

   procedure Blit_And_Premultiply (
      Target_Buffer : in out Pixel_Line_Type;
      Target_Stride : Natural;
      Source_Buffer : Pixel_Line_Type;
      Source_Stride : Natural;
      Width, Height : Natural
      )
   is
      Target_Bytes : Natural := Target_Buffer'First;
      Source_Bytes : Natural := Source_Buffer'First;
   begin
      for i in 1 .. Height loop
         Premultiply_Row(
            Target_Buffer(Target_Bytes .. Target_Buffer'Last),
            Source_Buffer(Source_Bytes .. Source_Buffer'Last),
            Width);
         Target_Bytes := Target_Bytes + Target_Stride;
         Source_Bytes := Source_Bytes + Source_Stride;
      end loop;
   end Blit_And_Premultiply;

begin
   Init(reciprocal_table);
end Cairo.CairoSDL;
